home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Decision Cube / mxqparse.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  25KB  |  829 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Borland Delphi Visual Component Library         }
  4. {                                                       }
  5. {       Copyright (c) 1997,99 Inprise Corporation       }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit mxqparse;
  10.  
  11. interface
  12.  
  13. uses
  14.   Windows, SysUtils, Classes, Dialogs, DB, DBTables, DBCommon,
  15.   BDE, mxqedcom, DBConsts, Activex, ComObj, mxcommon, mxconsts;
  16.  
  17. type
  18.   EQParseException = class(Exception);
  19.  
  20.   pRecProjInfo = ^recProjectorInfo;
  21.   recProjectorInfo = record
  22.     FieldNo: Integer;
  23.     FieldType: TFieldType;
  24.     OutputName: string;
  25.     CompareName: string;
  26.     BaseName: string;
  27.     projType: TDimFlags;
  28.   end;
  29.  
  30.   TQueryState = (txNone, txAddingSum, txAddingDim, txDeletingSum, txDeletingDim);
  31.  
  32.   TXtabQuery = class(TObject)
  33.   private
  34.     Fhdb: HDBIDB;
  35.     pQStmt: IQStmt;
  36.     FProjectors: TList;
  37.     FDimensions: TList;
  38.     FAggregates: TList;
  39.     FcanDelete: boolean;
  40.     FInitialized: boolean;
  41.     procedure setSQLString(newStr: String);
  42.     function getSQLString: string;
  43.     function getNProjectors: Integer;
  44.     function getNDimensions: Integer;
  45.     function getNAggregates: Integer;
  46.     function getProjector(Index: Integer): recProjectorInfo;
  47.     function getAggregate(Index: Integer): recProjectorInfo;
  48.     function getDimension(Index: Integer): recProjectorInfo;
  49.     function getNTables: Integer;
  50.     function getTableName(index: integer):string;
  51.     procedure buildProjectorMaps;
  52.     function XtabProjType(Expr: IExpr): TDimFlags;
  53.     function GetProjFieldType(Proj: IProjector): TFieldType;
  54.     function GetExprFieldType(Expr: IExpr): TFieldType;
  55.   public
  56.     function IsLegal: TQueryError;
  57.     function AllDimensionsGrouped: Boolean;
  58.     function AddNewItem(SQLTxt: string; newAgg: TDimFlags; index: integer; bGrouped: boolean; Name: string): integer;
  59.     procedure DeleteProjector(ProjIndex: Integer);
  60.     procedure FixUpGroupBys;
  61.     procedure DeleteGroupBys;
  62.     procedure DeleteDimensions;
  63.     procedure DeleteSummaries;
  64.     procedure DeleteProjectors;
  65.     procedure AddWhereCondition(Condition: string);
  66.     procedure AddWhereOp(FieldName: string; Condition: variant; Qtype: QNodeType);
  67.     function getDialectSQLString: string;
  68.     procedure AddTable(tableName: string);
  69.     constructor Create;
  70.     destructor Destroy; override;
  71.     property canDelete: boolean read FcanDelete write FcanDelete;
  72.     property Projector[Index: Integer]: recProjectorInfo read getProjector;
  73.     property Aggregate[Index: Integer]: recProjectorInfo read getAggregate;
  74.     property Dimension[Index: Integer]: recProjectorInfo read getDimension;
  75.     property TableName [Index: Integer]: string read getTableName;
  76.     property DBHandle: HdbiDB read Fhdb write Fhdb;
  77.   published
  78.     property SQLString: string read getSQLString write setSQLString;
  79.     property NProjectors: Integer read getNProjectors;
  80.     property NDimensions: Integer read getNDimensions;
  81.     property NTables: Integer read getNTables;
  82.     property NAggregates: Integer read getNAggregates;
  83.   end;
  84.  
  85.   function ptToQNode(pt: TDimFlags): QNodeType;
  86.   procedure BDEcheck(res: DBIResult);
  87.   function BDEDLLPath: string;
  88.  
  89. implementation
  90.  
  91. function FormatVariantQuoted(Value: Variant): string;
  92. var
  93.   VarData: TVarData;
  94. begin
  95.   VarData := TVarData(Value);
  96.   case TVarData(Value).vType of
  97.     varDouble   : Result := FormatFloat('', Value);
  98.     varCurrency : Result := FormatCurr('', Value);
  99.     varDate     : Result := '"' + FormatDateTime('M/D/Y', Value) + '"';
  100.     varInteger  : Result := FormatFloat('', Value);
  101.     else
  102.       Result := '"' + Value + '"';
  103.   end;
  104. end;
  105.  
  106. constructor TXTabQuery.create;
  107. var
  108.   bdepath: String;
  109. begin
  110.   { runtime registry initialization. }
  111.   bdePath := BDEDLLPath;
  112.   CreateRegKey('CLSID\{FB99D700-18B9-11D0-A4CF-00A024C91936}\InProcServer32', '', bdePath + 'IDSQL32.DLL');
  113.   pQStmt := nil;
  114.   FProjectors := TList.create;
  115.   FDimensions := TList.create;
  116.   FAggregates := TList.create;
  117.   FcanDelete := false;
  118.   FInitialized := false;
  119. end;
  120.  
  121. destructor TXTabQuery.Destroy;
  122. begin
  123.   FProjectors.free;
  124.   FDimensions.free;
  125.   FAggregates.free;
  126.   inherited Destroy;
  127. end;
  128.  
  129.   { This initializes BDE with the SQL String - the parse tree is now ready for use}
  130.   
  131. procedure TXtabQuery.setSQLString(newStr: String);
  132. const
  133.   {
  134.     !!! DO NOT REPLACE THESE WITH THE STANDARD IUnknown AND IClassFactory
  135.     !!! SIGNATURES.  BDE EXPECTS THE FOLLOWING SIGNATURES RATHER THAN THE
  136.     !!! STANDARD ONES IN ACTIVEX.PAS!
  137.   }
  138.   IID_BDE_IUnknown: TGUID = (
  139.       D1:  $15030000;
  140.       D2:  $0000;
  141.       D3:  $0000;
  142.       D4:  ($C0, $00, $00, $00, $00, $00, $00, $46));
  143.  
  144.   IID_BDE_IClassFactory: TGUID = (
  145.       D1:  $16030000;
  146.       D2:  $0000;
  147.       D3:  $0000;
  148.       D4:  ($C0, $00, $00, $00, $00, $00, $00, $46));
  149.       
  150. var
  151.   nProjs, i: UINT16;
  152.   proj: IProjector;
  153.   ret: DBIResult;
  154.   bDeleted: boolean;
  155.   pDelObj: PDeletedObj;
  156.   pQstmtFactory: IClassFactory;
  157.   pQstmtUnknown: IUnknown;
  158. begin
  159.   if assigned(pQstmt) then pQstmt := nil;    { note: this calls release }
  160.   if not assigned(pQstmt) then
  161.   begin
  162.     OleCheck(CoInitialize(nil));
  163.     { ! DO NOT REPLACE IID_BDE_IClassFactory WITH IClassFactory.  See above. }
  164.     OleCheck(CoGetClassObject(CLSID_IDSQL32, CLSCTX_INPROC_SERVER, nil, IID_BDE_IClassFactory, pQstmtFactory));
  165.     { ! DO NOT REPLACE IID_BDE_IUnknown WITH IUnknown.  See above. }
  166.     OleCheck(pQstmtFactory.CreateInstance(nil, IID_BDE_IUnknown, pQstmtUnknown));
  167.     OleCheck(pQstmtUnknown.QueryInterface(IID_IQStmt, pQstmt));
  168.   end;
  169.   ret := pQstmt.Initialize(FhDb, PChar(newstr));
  170.   if (ret = $2eaf) or (ret = $2eb7) then
  171.     FixupGroupBys
  172.   else
  173.     BDECheck(ret);  { otherwise, surface the error. }
  174.   FInitialized := true;
  175.   BDECheck(pQStmt.GetNumProjectors(nProjs));
  176.   bDeleted := false;
  177.   if FcanDelete then
  178.     for i := nProjs downto 1 do
  179.     begin
  180.       BDECheck(pQStmt.FetchProjector(i, proj));  { fetch the projector }
  181.       BDECheck(pQStmt.ProjTextToObj(proj));
  182.       if (GetProjFieldType(proj) in [ftUnknown,ftBytes, ftBlob]) then
  183.       begin
  184.         bDeleted := true;
  185.         pQStmt.DeleteProjector(proj, pdelObj);
  186.       end;
  187.     end;
  188.   if bDeleted then ShowMessage(SQParseRemovedField);
  189.   buildProjectorMaps;
  190. end;
  191.  
  192. { Requests that BDE re-generate the string. }
  193.  
  194. function TXtabQuery.getSQLString: string;
  195. var
  196.   res: PChar;
  197.   drvType: UINT32;
  198. const
  199.   useJoinKeyword = TRUE;
  200. begin
  201.   BDECheck(pQStmt.GetSQLText(res, drvType, useJoinKeyword, ANSI));
  202.   Result := res;
  203. end;
  204.  
  205. procedure TXtabQuery.AddTable(tableName: string);
  206. var
  207.   pTable: ITable;
  208. begin
  209.   BDECheck(pQStmt.AddInputTable(pchar(TableName), pchar(nil), nil, nil, pTable, nil));
  210. end;
  211.  
  212. function TXtabQuery.getDialectSQLString: string;
  213. var
  214.   res: PChar;
  215.   drvType: UINT32;
  216. const
  217.   useJoinKeyword = TRUE;
  218. begin
  219.   BDECheck(pQStmt.GetSQLText(res, drvType, useJoinKeyword, DIALECTANSI));
  220.   Result := res;
  221. end;
  222.  
  223. function TXtabQuery.IsLegal: TQueryError;
  224. begin
  225.   if (NDimensions <= 0) then
  226.     Result := tqeNoDimensions
  227.   else if (NAggregates <= 0) then
  228.     Result := tqeNoAggs
  229.   else if not AllDimensionsGrouped then
  230.     Result := tqeNotGrouped
  231.   else
  232.     Result := tqeOK;
  233. end;
  234.  
  235. function TXtabQuery.AllDimensionsGrouped : Boolean;
  236. var
  237.   nGroupedBy: UINT16;
  238. begin
  239.   Result := FALSE;
  240.   BDECheck(pQStmt.GetNumGroupBy(nGroupedBy));
  241.   if (nGroupedBy < NDimensions) then Exit;
  242.   Result := TRUE;
  243. end;
  244.  
  245. function TXtabQuery.AddNewItem(SQLTxt: string; newAgg: TDimFlags; index: integer; bGrouped: boolean; Name: string): integer;
  246. var
  247.   newProjExpr, newProjSubExpr: IExpr;
  248.   befProj, newProj: IProjector;
  249.   projField: IField;
  250.   qnType: QNodeType;
  251.   pDelObj: pDeletedObj;
  252. begin
  253.   newProj := nil;
  254.   try
  255.     befproj := nil;
  256.     if (index < nProjectors) then
  257.       BDECheck(pQStmt.FetchProjector(index + 1 ,befproj));  { fetch the projector }
  258.     if (NewAgg = dimDimension) then  { add a new dimension }
  259.     begin
  260.       projField := nil;
  261.       BDECheck(pQStmt.IsField(pchar(SQLTxt), projField));
  262.       if (projField <> nil) then
  263.         BDECheck(pQStmt.AddProjector_field(projField, newProj, befProj, true))  { add a new SUMMARY NODE }
  264.       else
  265.       begin
  266.         BDECheck(pQStmt.AddProjector_text(pchar(SQLTxt), newProj, befProj));  { add a new SUMMARY NODE }
  267.         BDECheck(pQStmt.ProjTextToObj(newproj));
  268.       end;
  269.     end
  270.     else if (NewAgg = dimGenericAgg) then
  271.     begin
  272.       BDECheck(pQStmt.AddProjector_text(pchar(SQLTxt), newProj, befProj));  { add a new SUMMARY NODE }
  273.       BDECheck(pQStmt.ProjTextToObj(newProj));
  274.     end
  275.     else  { add a new aggregator }
  276.     begin
  277.       qnType := ptToQNode(newAgg);  { convert to BDE QnodeType; }
  278.       BDECheck(pQStmt.AddProjector_node(qnType, newProj, befProj, TRUE));  { add a new SUMMARY NODE }
  279.       BDECheck(newproj.FetchExpr(newProjExpr));  { get the NEW expression -- First item is Summary node. }
  280.       projField := nil;
  281.       BDECheck(pQStmt.IsField(pchar(SQLTxt), projField));
  282.       if (projField <> nil) then
  283.         BDECheck(newProjExpr.AddSubExpr_field(projField, newProjSubExpr, nil))  { add the SQL for the argument to the agg. }
  284.       else
  285.       begin
  286.         BDECheck(newProjExpr.AddSubExpr_text(pchar(SQLTxt), newProjSubExpr, nil)); { add the SQL for the argument to the agg. }
  287.         BDECheck(pQStmt.ProjTextToObj(newproj));
  288.       end;
  289.     end;
  290.     Result := Index;  { Result offset from 0 }
  291.     if (name <> '') then
  292.       BDECheck(pQStmt.SetProjectorName(newProj, pchar(name)))
  293.     else
  294.       BDECheck(pQStmt.GenerateDefProjName(newProj));
  295.     buildProjectorMaps;
  296.     if bGrouped then FixUpGroupBys;
  297.   except
  298.     on E: exception do
  299.     begin
  300.       if assigned(newproj) then pQStmt.DeleteProjector(newproj, pdelObj);
  301.       raise EQParseException.create(e.message);
  302.     end;
  303.   end;
  304. end;
  305.  
  306. procedure TXtabQuery.DeleteProjector(ProjIndex: Integer);
  307. var
  308.   proj: IProjector;
  309.   projField: IField;
  310.   nGroups: UINT16;
  311.   groupby: IGroupBy;
  312.   projExpr: iExpr;
  313.   STRtEMP: pchar;
  314.   fieldname: string;
  315.   deleteName: string;
  316.   nType: QnodeType;
  317.   pDelObj: pDeletedObj;
  318.   i: integer;
  319. begin
  320.   proj := nil;
  321.   pQStmt.FetchProjector(ProjIndex + 1, proj);  { fetch the projector }
  322.   try
  323.     if (Projector[ProjIndex].projType = dimDimension) then
  324.     begin
  325.       BDECheck(proj.FetchExpr(projExpr));  { get its expression object }
  326.       BDECheck(projExpr.GetNodeType(nType));
  327.       if (nType = qnodeField) then  { if it's a field, delete it }
  328.       begin
  329.         projField := nil;
  330.         BDECheck(projExpr.FetchField(projField));
  331.         if (projField <> nil) then
  332.         begin
  333.           BDECheck(projField.GetTable_Field(strTemp));
  334.           deleteName := strTemp;
  335.           pQStmt.GetNumGroupBy(nGroups);
  336.           for I := 0 to nGroups-1 do
  337.           begin
  338.             pQStmt.FetchGroupBy(I + 1, groupBy);
  339.             groupBy.FetchField(projField);
  340.             if (projField <> nil) then
  341.             begin
  342.               BDECheck(projField.GetTable_Field(strTemp));
  343.               fieldName := strTemp;
  344.               if (fieldName = deleteName) then
  345.               begin
  346.                 pQStmt.DeleteGroupBy(groupBy);
  347.                 Break;
  348.               end;
  349.             end;
  350.           end;
  351.         end;
  352.       end;
  353.     end
  354.     else
  355.     begin
  356.       {}
  357.     end;
  358.     pQStmt.DeleteProjector(proj, pDelObj);
  359.     buildProjectorMaps;
  360.   finally
  361.     {}
  362.   end;
  363. end;
  364.  
  365. procedure TXtabQuery.DeleteGroupBys;
  366. var
  367.   nGroups: UINT16;
  368.   groupby: IGroupBy;
  369.   i: integer;
  370. begin
  371.   pQStmt.GetNumGroupBy(nGroups);
  372.   for I := 0 to nGroups-1 do
  373.   begin
  374.     pQStmt.FetchGroupBy(1, groupBy);
  375.     pQStmt.DeleteGroupBy(groupBy);
  376.   end;
  377. end;
  378.  
  379. procedure TXtabQuery.DeleteDimensions;
  380. var
  381.   i: integer;
  382. begin
  383.   for I := nProjectors-1 downto 0 do
  384.   begin
  385.     if (Projector[i].ProjType = dimDimension) then DeleteProjector(I);
  386.   end;
  387.   buildProjectorMaps;
  388. end;
  389.  
  390. procedure TXtabQuery.DeleteSummaries;
  391. var
  392.   i: integer;
  393. begin
  394.   for I := nProjectors-1 downto 0 do
  395.   begin
  396.     if (Projector[i].ProjType <> dimDimension) then DeleteProjector(I);
  397.   end;
  398.   buildProjectorMaps;
  399. end;
  400.  
  401. procedure TXtabQuery.DeleteProjectors;
  402. var
  403.   i: integer;
  404. begin
  405.   for I := nProjectors-1 downto 0 do
  406.     DeleteProjector(I);
  407.   buildProjectorMaps;
  408. end;
  409.  
  410. procedure TXtabQuery.FixUpGroupBys;
  411. var
  412.   proj: IProjector;
  413.   projField: IField;
  414.   nGroups: UINT16;
  415.   groupby: IGroupBy;
  416.   projExpr: iExpr;
  417.   i: integer;
  418.   nType: qNodeTYpe;
  419. begin
  420.   pQStmt.GetNumGroupBy(nGroups);
  421.   for I := 0 to nGroups-1 do
  422.   begin
  423.     pQStmt.FetchGroupBy(1, groupBy);
  424.     pQStmt.DeleteGroupBy(groupBy);
  425.   end;
  426.   for i := 0 to NProjectors-1 do
  427.   begin
  428.     pQStmt.FetchProjector(i + 1, proj);  { fetch the projector }
  429.     BDECheck(proj.FetchExpr(projExpr));  { get its expression object }
  430.     if (XtabProjType(projExpr) = dimDimension) then
  431.     begin
  432.       BDECheck(projExpr.GetNodeType(nType));
  433.       if (nType <> qnodeFIeld) then
  434.         raise EQParseException.CreateRes(@sGroupOnExpressionError);
  435.       projField := nil;
  436.       BDECheck(projExpr.FetchField(projField));
  437.       if (projField <> nil) then
  438.         pQStmt.AddGroupBy_Field(projField, groupBy, nil);
  439.     end;
  440.   end;
  441.   buildProjectorMaps;
  442. end;
  443.  
  444. procedure TXTabQuery.AddWhereOp(FieldName: string; Condition: variant; Qtype: QNodeType);
  445. var
  446.   op: String;
  447. begin
  448.   case Qtype of
  449.     qnodeEqual     : op := ' = ';
  450.     qnodeGreaterEq : op := ' >= ';
  451.     qnodeGreater   : op := ' > ';
  452.     qnodeLessEq    : op := ' <= ';
  453.     qnodeLess      : op := ' < ';
  454.     qnodeNotEqual  : op := ' <> ';
  455.     else
  456.       op := ' = ';
  457.   end;
  458.   AddWhereCondition(FieldName + op + FormatVariantQuoted(Condition));
  459. end;
  460.  
  461. procedure TXTabQuery.AddWhereCondition(Condition: String);
  462. var
  463.   whereExpr: iExpr;
  464.   subExpr: iExpr;
  465.   nType: QNodeType;
  466.   oldCondition: pChar;
  467.   i: integer;
  468.   nSubs: UINT16;
  469. begin
  470.   BDECheck(pQStmt.FetchWhereExpr(whereExpr));
  471.   BDECHeck(whereExpr.GetNodeType(nType));
  472.   if (nType <> qNodeAnd) then
  473.   begin
  474.     BDECHECK(whereExpr.GetSQLText(oldCondition));
  475.     BDECHECK(whereExpr.GetNumbSubExprs(nSubs));
  476.     for i := 1 to nSubs do
  477.     begin
  478.       BDECHECK(whereExpr.FetchSubExpr(1, SubExpr));
  479.       BDECHECK(whereExpr.DeleteSubExpr(SubExpr));
  480.     end;
  481.     BDECHECK(whereExpr.ChangeNodeType(qNodeAnd));
  482.     BDECheck(whereExpr.AddSubExpr_Text(pchar(oldCondition), subExpr, nil));
  483.   end;
  484.   BDECheck(whereExpr.AddSubExpr_Text(pchar(Condition), subExpr, nil));
  485. end;
  486.  
  487. function TXtabQuery.getNProjectors: Integer;
  488. begin
  489.   Result := FProjectors.count;
  490. end;
  491.  
  492. function TXtabQuery.getNDimensions: Integer;
  493. begin
  494.   Result := FDimensions.count;
  495. end;
  496.  
  497. function TXtabQuery.getNAggregates: Integer;
  498. begin
  499.   Result := FAggregates.Count;
  500. end;
  501.  
  502. function TXtabQuery.getProjector(Index: Integer): recProjectorInfo;
  503. begin
  504.   Result := recProjectorInfo(FProjectors[index]^);
  505. end;
  506.  
  507. function TXtabQuery.getAggregate(Index: Integer): recProjectorInfo;
  508. begin
  509.   Result := recProjectorInfo(FAggregates[index]^);
  510. end;
  511.  
  512. function TXtabQuery.getDimension(Index: Integer): recProjectorInfo;
  513. begin
  514.   Result := recProjectorInfo(FDimensions[index]^);
  515. end;
  516.  
  517. function TXTabQuery.getNTables: Integer;
  518. var
  519.   nTables: UINT16;
  520.  
  521. begin
  522.   if assigned(pQStmt) and FInitialized then
  523.   begin
  524.     BDECheck(pQStmt.GetNumInputTables(nTables));
  525.     Result := nTables;
  526.   end
  527.   else
  528.     Result := 0;
  529. end;
  530.  
  531. function TXTabQuery.getTableName(index: integer): string;
  532. var
  533.   pTable: ITable;
  534.   temp: pChar;
  535. begin
  536.   BDECheck(pQStmt.FetchInputTable((index + 1), pTable));
  537.   BDECheck(pTable.GetName(temp));
  538.   Result := temp;
  539. end;
  540.  
  541. procedure TXTabQuery.buildProjectorMaps;
  542. var
  543.   ind: integer;
  544.   nProjs, i: UINT16;
  545.   nSubs: UINT16;
  546.   projExpr: IExpr;
  547.   subExpr: IExpr;
  548.   proj: IProjector;
  549.   projfield: IField;
  550.   strTemp: PChar;
  551.   pInfo: pRecProjInfo;
  552.   nType: QNodeType;
  553.   dType, dSubType: UINT16;
  554.   fError: string;
  555. begin
  556.   FProjectors.clear;  { clear the TLists. }
  557.   FDimensions.clear;
  558.   FAggregates.clear;
  559.   fError := '';
  560.   BDECheck(pQStmt.GetNumProjectors(nProjs));
  561.   for i := 1 to nProjs do
  562.   begin
  563.     New(pInfo);
  564.     try
  565.       BDECheck(pQStmt.FetchProjector(i, proj));  { fetch the projector }
  566.       BDECheck(proj.GetName(strTemp));  { get the output field name }
  567.       BDECheck(proj.FetchExpr(projExpr));  { get its expression object }
  568.       pInfo.FieldNo := i;
  569.       pInfo.projType := XtabProjType(projExpr);
  570.       FProjectors.add(pInfo);  { add to the field map }
  571.       pInfo.OutputName := strTemp;
  572.       BDECheck(projExpr.GetSQLText(strTemp));  { get the SQL for the argument to the agg }
  573.       pInfo.CompareName := strTemp;
  574.       {
  575.         This is all to set the BaseName and the Fieldtype for all different types
  576.         Note the Fieldtype is the type of the base field, not of the projector
  577.       }
  578.       if (pInfo.projType = dimDimension) then
  579.       begin
  580.         BDECheck(projExpr.GetNodeType(nType));  { get expr's node type; }
  581.         if (nType = qnodeField) then
  582.         begin
  583.           projField := nil;
  584.           BDECheck(projExpr.FetchField(projField));
  585.           if (projField <> nil) then
  586.           begin
  587.             BDECheck(projField.GetTable_Field(strTemp));
  588.             pInfo.BaseName := strTemp;
  589.             BDECheck(projField.GetDataType(dType, dSubType));
  590.             pInfo.FieldType := DataTypeMap[dType];
  591.           end
  592.           else
  593.           begin
  594.             pInfo.FieldType := ftUnknown;
  595.             pInfo.BaseName := pInfo.CompareName;
  596.           end;
  597.         end
  598.         else
  599.         begin
  600.           pInfo.FieldType := ftUnknown;
  601.           pInfo.BaseName := pInfo.CompareName;
  602.         end;
  603.         FDimensions.add(pInfo);
  604.       end
  605.       else  { add an expression, either a single argument or multiply }
  606.       begin
  607.         if (AnsiUpperCase(pInfo.OutputName) = sCountStar) then
  608.         begin
  609.           pInfo.FieldType := ftUnknown;
  610.           pInfo.BaseName := '*';
  611.         end
  612.         else
  613.         begin
  614.           BDECHECK(projExpr.GetNumbSubExprs(nSubs));
  615.           if (nSubs = 0) then
  616.             raise EQParseException.CreateRes(@sArgumentExpected)
  617.           else if (nSubs > 1) then
  618.           begin
  619.             pInfo.FieldType := ftUnknown;  { don't allow a base type for complex expressions }
  620.             pInfo.BaseName := pInfo.CompareName;
  621.           end
  622.           else
  623.           begin
  624.             BDECheck(projExpr.FetchSubExpr(1, subExpr));  { get the argument to the agg }
  625.             BDECheck(subExpr.GetNodeType(nType));  { get expr's node type; }
  626.             if (nType = qnodeField) then  { simple agg of a field }
  627.             begin
  628.               projField := nil;
  629.               BDECheck(subExpr.FetchField(projField));
  630.               if (projField <> nil) then
  631.               begin
  632.                 BDECheck(projField.GetTable_Field(strTemp));
  633.                 pInfo.BaseName := strTemp;
  634.                 BDECheck(projField.GetDataType(dType, dSubType));
  635.                 pInfo.FieldType := DataTypeMap[dType];
  636.               end
  637.               else  { fieldtype of an expr that didn't get parse correctly }
  638.               begin
  639.                 pInfo.FieldType := GetExprFieldType(subExpr);
  640.                 BDECheck(subExpr.GetSQLText(strtemp));
  641.                 pInfo.BaseName := strTemp;
  642.               end;
  643.             end
  644.             else  { agg of something other than a field }
  645.             begin
  646.               BDECheck(subExpr.GetSQLText(strTemp));
  647.               pInfo.FieldType := GetExprFieldType(subExpr);
  648.               pInfo.BaseName := strTemp;
  649.             end;
  650.           end;
  651.         end;
  652.         FAggregates.add(pInfo);
  653.       end;
  654.     except
  655.       on e: exception do
  656.       begin
  657.         ind := FProjectors.indexof(pInfo);
  658.         if (ind >= 0) then FProjectors.Delete(ind);
  659.         ind := FAggregates.indexof(pInfo);
  660.         if (ind >= 0) then FAggregates.Delete(ind);
  661.         ind := FDimensions.indexof(pInfo);
  662.         if (ind >= 0) then FDimensions.Delete(ind);
  663.         fError := e.message;
  664.       end;
  665.     end;
  666.   end;
  667.   if (fError <> '') then raise exception.Create(fError);
  668. end;
  669.  
  670. {
  671.   Determine the type of the expression passed in
  672.   a GenericAgg
  673. }
  674.  
  675. function TXtabQuery.XtabProjType(Expr: IExpr): TDimFlags;
  676. var
  677.   subExpr: IExpr;
  678.   nType: QNodeType;
  679.   i, nSubs: UINT16;
  680. begin
  681.   Result := dimDimension;
  682.   BDECheck(Expr.GetNodeType(nType));
  683.   case nType of
  684.     qNodeField : Exit;
  685.     qNodeAvg   : Result := dimAverage;
  686.     qNodeCount : Result := dimCount;
  687.     qnodeMax   : Result := dimMax;
  688.     qnodeMin   : Result := dimMin;
  689.     qnodeTotal : Result := dimSum;
  690.     qnodeUnknown:
  691.     begin
  692.       Result := dimUnknown;
  693.     end;
  694.     else
  695.     begin
  696.       if (ntype in [qnodeAdd,qnodeConstant, qnodeDivide, qnodeMultiply,
  697.       qnodeSubtract,qnodeCast,qnodeUdf,qnodeTrim,qnodeLower,
  698.       qnodeUpper,qnodeSubstring,qnodeExtract,qnodeConcatenate])
  699.       then
  700.          Result := dimDimension
  701.       else
  702.         Result := dimUnknown;
  703.     end;
  704.   end;
  705.   {
  706.     if it is marked a dimension and we get here, it is not calculated expression
  707.     Need to determine whether it contains an aggregator somewhere or not
  708.     if so, type it as a "GenericAgg".  Otherwise, it is a dimension
  709.   }
  710.   if (Result = dimDimension) then
  711.   begin
  712.     BDECHECK(Expr.GetNumbSubExprs(nSubs));
  713.     for i := 1 to nSubs do
  714.     begin
  715.       BDECheck(Expr.FetchSubExpr(i, subExpr));
  716.       if (XtabProjType(subExpr) in [dimAverage, dimCount, dimMax, dimMin, dimSum, dimGenericAgg]) then
  717.       begin
  718.         Result := dimGenericAgg;
  719.       end;
  720.     end;
  721.   end;
  722. end;
  723.  
  724. function TXtabQuery.GetProjFieldType(Proj: IProjector): TFieldType;
  725. var
  726.   projExpr: iExpr;
  727.   nType: QNodeType;
  728. begin
  729.   BDECheck(proj.FetchExpr (projExpr));  { get its expression object }
  730.   Result := GetExprFieldType(projExpr);
  731.   if (Result = ftUnknown) then
  732.   begin
  733.     BDECheck(projExpr.GetNodeType(nType));
  734.     if (nType = qnodeConstant) then Result := ftFloat;
  735.   end;
  736. end;
  737.  
  738. {
  739.   this is a very conservative field typing routine
  740.   if it really doesn't know, it returns ftUnknown
  741.   Type information can be gotten from fieldInfo or operators
  742. }
  743.  
  744. function TXtabQuery.GetExprFieldType(Expr: IExpr): TFieldType;
  745. var
  746.   subExpr: IExpr;
  747.   nType: QNodeType;
  748.   i, nSubs: UINT16;
  749.   projfield: IField;
  750.   dType, dSubType: UINT16;
  751. begin
  752.   Result := ftUnknown;
  753.   BDECheck(Expr.GetNodeType(nType));
  754.   case nType of
  755.     qNodeField:
  756.     begin
  757.       BDECheck(Expr.FetchField(projField));
  758.       BDECheck(projField.GetDataType(dType, dSubType));
  759.       Result := DataTypeMap[dType];
  760.     end;
  761.     qNodeCount,
  762.     qNodeMultiply,
  763.     qNodeDivide,
  764.     qNodeSubtract,
  765.     qNodeAvg,
  766.     qNodeTotal: Result := ftFloat;
  767.     qNodeUpper,
  768.     qNodeLower,
  769.     qNodeExtract,
  770.     qNodeConcatenate,
  771.     qNodeTrim,
  772.     qNodeSubString: Result := ftString;
  773.     else
  774.     begin
  775.       BDECHECK(Expr.GetNumbSubExprs(nSubs));
  776.       for i := 1 to nSubs do
  777.       begin
  778.         BDECheck(Expr.FetchSubExpr(i, subExpr));
  779.         Result := GetExprFieldType(subExpr);
  780.         if (Result <> ftUnknown) then Break;
  781.       end;
  782.     end;
  783.   end;
  784. end;
  785.  
  786. procedure BDEcheck(res: DBIResult);
  787. begin
  788.   if (res <> DBIERR_NONE) then DBIError(res);
  789. end;
  790.  
  791. function ptToQNode(pt: TDimFlags): QNodeType;
  792. begin
  793.   case pt of
  794.     dimAverage: Result := QNodeAvg;
  795.     dimCount: Result := QNodeCount;
  796.     dimMin: Result := QNodeMin;
  797.     dimMax: Result := QNodeMax;
  798.     dimSum: Result := QNodeTotal;
  799.     else
  800.       Result := QNodeUnknown;
  801.   end;
  802. end;
  803.  
  804. function BDEDLLPath: string;
  805. const
  806.   BDEPath = 'SOFTWARE\BORLAND\DATABASE ENGINE';
  807.   DLLpath = 'DLLPATH';
  808. var
  809.   Key: HKey;
  810.   StrLen: Integer;
  811.   Buffer: array[0..MAX_PATH] of Char;
  812. begin
  813.   if RegOpenKeyEx(HKEY_LOCAL_MACHINE, BDEPath, 0, KEY_READ, Key) = ERROR_SUCCESS then
  814.   begin
  815.     StrLen := SizeOf(Buffer);
  816.     if (RegQueryValueEx(Key, DLLPath,  nil, nil, @Buffer, @StrLen) = ERROR_SUCCESS) then
  817.     begin
  818.       Result := Buffer;
  819.       { Check for multiple directories, use only the first one }
  820.       if (Pos(';', Result) > 0) then Result := Copy(Result, 1, Pos(';', Result) - 1);
  821.       if (Length(Result) > 2) and (not IsPathDelimiter(Result, Length(Result))) then
  822.         Result := Result + '\';
  823.     end;
  824.     RegCloseKey(Key);
  825.   end;
  826. end;
  827.  
  828. end.
  829.